home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0112_COPPER2.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  12KB  |  448 lines
  1. Program CopperExampleNo2;
  2. {$G+} { Enable 286 Instructions }
  3.  
  4. {                                }
  5. {       Copper Example #2        }
  6. {    Programmed by David Dahl    }
  7. {                                }
  8. { THIS EXAMPLE RUNS IN TEXT MODE }
  9. {                                }
  10. {     This is PUBLIC DOMAIN      }
  11. {                                }
  12.  
  13.  
  14. { This Example Works FLAWLESSLY On My ET4000AX Based VGA Card.    }
  15. { On My Friend's Trident, However, The Three Sinus Bars Have Snow }
  16. { Covering Their Leftmost Sides For About An Inch.  This Is Due   }
  17. { To The Double VGA DAC Set Required To Display Both The Sinus    }
  18. { Bars And The Smooth Color Transitions Of The Large Text.        }
  19.  
  20. Uses CRT;
  21.  
  22. Const MaxRaster = 399;
  23.  
  24.       Status1   = $3DA;
  25.       DACWrite  = $3C8;
  26.       DACData   = $3C9;
  27.  
  28. Type  CopperRec   = Record
  29.                           Color : Byte;
  30.                           Red   : Byte;
  31.                           Green : Byte;
  32.                           Blue  : Byte;
  33.                     End;
  34.  
  35.       CopperArray = Array [0..MaxRaster] of CopperRec;
  36.  
  37.       BarArray    = Array [0..19] of CopperRec;
  38.  
  39. Var   CopperList : CopperArray;
  40.  
  41.       Bar        : Array[0..2] of BarArray;
  42.       BarPos     : Array[0..2] of Integer;
  43.  
  44.       SinTab     : Array[0..255] of Integer;
  45.  
  46. {-[ Build Sine Lookup Table ]----------------------------------------------}
  47. Procedure MakeSinTab;
  48. Var Counter : Integer;
  49. Begin
  50.      For Counter := 0 to 255 do
  51.          SinTab[Counter] := 115 + Round(90 * Sin(Counter * PI / 128));
  52. End;
  53. {-[ Build Colors For Sinus Bars ]------------------------------------------}
  54. Procedure MakeBars;
  55. Var Counter : Integer;
  56. Begin
  57.      { Clear Colors }
  58.      FillChar (Bar, SizeOf(Bar), 0);
  59.  
  60.      For Counter := 0 to 9 do
  61.      Begin
  62.           Bar[0][Counter].Red   := Trunc(Counter * (63 / 9));
  63.           Bar[1][Counter].Green := Trunc(Counter * (63 / 9));
  64.           Bar[2][Counter].Blue  := Trunc(Counter * (63 / 9));
  65.           If Odd(Counter)
  66.           Then
  67.           Begin
  68.                Bar[0][Counter].Green := Trunc(Counter * (63 / 9));
  69.                Bar[1][Counter].Red   := Trunc(Counter * (63 / 9));
  70.                Bar[1][Counter].Blue  := Trunc(Counter * (63 / 9));
  71.                Bar[2][Counter].Green := Trunc(Counter * (63 / 9));
  72.           End;
  73.      End;
  74.      For Counter := 10 to 19 do
  75.      Begin
  76.           Bar[0][Counter].Red   := Trunc((19-Counter) * (63 / 9));
  77.           Bar[1][Counter].Green := Trunc((19-Counter) * (63 / 9));
  78.           Bar[2][Counter].Blue  := Trunc((19-Counter) * (63 / 9));
  79.           If Odd(Counter)
  80.           Then
  81.           Begin
  82.                Bar[0][Counter].Green := Trunc((19-Counter) * (63 / 9));
  83.                Bar[1][Counter].Red   := Trunc((19-Counter) * (63 / 9));
  84.                Bar[1][Counter].Blue  := Trunc((19-Counter) * (63 / 9));
  85.                Bar[2][Counter].Green := Trunc((19-Counter) * (63 / 9));
  86.           End;
  87.      End;
  88. End;
  89. {-[ Make COPPER List ]-----------------------------------------------------}
  90. Procedure MakeCopperList;
  91. Var Counter1 : Integer;
  92.     Counter2 : Integer;
  93. Begin
  94.      { Clear List }
  95.      FillChar (CopperList, SizeOf(CopperList), 0);
  96.  
  97.      { Make Transition From White To Yellow For }
  98.      { Color 1 On Scanlines 10 Through 250      }
  99.      For Counter1 := 10 to 250 do
  100.      With CopperList[Counter1] do
  101.      Begin
  102.           Color := 1;
  103.           Red   := 63;
  104.           Green := 63;
  105.           Blue  := Round((250 - Counter1) * (63 / 200));
  106.      End;
  107.  
  108.      { Make Transition From Black To Dark Blue For }
  109.      { Color 0 On Scanlines 254 Through 274        }
  110.      For Counter1 := 254 to 254 + 20 do
  111.      With CopperList[Counter1] do
  112.      Begin
  113.           Color := 0;
  114.           Red   := 0;
  115.           Green := 0;
  116.           Blue  := Counter1 - 254;
  117.      End;
  118.      { Make Dark Blue Background (Color 0) For   }
  119.      { Scanlines 275 Through 287 Except Scanline }
  120.      { 280 Which Is Yellow                       }
  121.      For Counter1 := 275 to 287 do
  122.      With CopperList[Counter1] do
  123.      Begin
  124.           Color := 0;
  125.           Red   := 0;
  126.           Green := 0;
  127.           If Counter1 = 280
  128.           Then
  129.           Begin
  130.                Red   := 45;
  131.                Green := 45;
  132.           End
  133.           Else
  134.               Blue := 20;
  135.      End;
  136.      { Make Dark Blue Background (Color 0) For   }
  137.      { Scanlines 336 Through 394 Except Scanline }
  138.      { 343 Which Is Yellow                       }
  139.      For Counter1 := 336 to 349 do
  140.      With CopperList[Counter1] do
  141.      Begin
  142.           Color := 0;
  143.           Red   := 0;
  144.           Green := 0;
  145.           If Counter1 = 343
  146.           Then
  147.           Begin
  148.                Red   := 45;
  149.                Green := 45;
  150.           End
  151.           Else
  152.               Blue := 20;
  153.      End;
  154.      { Make Transition From Dark Blue To Black }
  155.      { For Background From Scanline 350 to 370 }
  156.      For Counter1 := 350 to 350 + 20 do
  157.      With CopperList[Counter1] do
  158.      Begin
  159.           Color := 0;
  160.           Red   := 0;
  161.           Green := 0;
  162.           Blue  := (350 + 20 - Counter1);
  163.      End;
  164.  
  165.      { Color Text Lines 18, 19, and 20 For Text Color 1 }
  166.      { As Red -> Yellow (L18), Purple -> White (L20)    }
  167.      For Counter1  := 18 to 20 do
  168.        For Counter2 := 0 to 15 do
  169.        With CopperList[Counter2 + (Counter1 * 16)] do
  170.        Begin
  171.             Color := 1;
  172.             Red   := 63;
  173.             Green := Trunc(Counter2 * (63 / 15));
  174.             Blue  := ((Counter1 - 18) * 31) AND 63;
  175.        End;
  176. End;
  177. {-[ Center And Write A String As Solid Chars And Spaces ]------------------}
  178. Procedure WSol (StringIn : String);
  179. Var Counter : Integer;
  180. Begin
  181.      For Counter := 1 to (40 - (Length(StringIn) DIV 2)) do
  182.          Write(#32);
  183.  
  184.      For Counter := 1 to Length(StringIn) do
  185.        If StringIn[Counter] <> #32
  186.        Then
  187.            Write (#219)
  188.        Else
  189.            Write (#32);
  190.  
  191.      Writeln;
  192. End;
  193. {-[ Put Text On Screen ]---------------------------------------------------}
  194. Procedure SetUpScreen;
  195. Begin
  196.      ClrScr;
  197.  
  198.      GotoXY (1,5);
  199.      TextColor (1);
  200.      WSol('  ####     ####    ######    ######    ########  ######  ');
  201.      WSol(' ##  ##   ##  ##   ##   ##   ##   ##   ##        ##   ## ');
  202.      WSol('##       ##    ##  ##    ##  ##    ##  ##        ##    ##');
  203.      WSol('##       ##    ##  ##    ##  ##    ##  #####     ##    ##');
  204.      WSol('##       ##    ##  ##   ##   ##   ##   ##        ##   ## ');
  205.      WSol('##       ##    ##  ######    ######    ##        ######  ');
  206.      WSol(' ##  ##   ##  ##   ##        ##        ##        ##   ## ');
  207.      WSol('  ####     ####    ##        ##        ########  ##    ##');
  208.      GotoXY(21, 19);
  209.      Writeln('Textmode COPPER Example #2 by David Dahl');
  210.      GotoXY(27, 21);
  211.      Writeln('This Program is Public Domain');
  212. End;
  213. {-[ Update COPPER ]--------------------------------------------------------}
  214. Procedure UpdateCopper;
  215. Var Raster     : Word;
  216.     DrawBar    : Integer;
  217.     BarNum     : Integer;
  218.     BarCounter : Integer;
  219. Begin
  220.      Raster := 1;
  221.  
  222.      DrawBar := -1;
  223.      BarNum  := 0;
  224.  
  225.      Inc(BarPos[0],1);
  226.      Inc(BarPos[1],1);
  227.      Inc(BarPos[2],1);
  228.  
  229.      { Sorry For All The Assembly Here, But Plain Vanilla Pascal  }
  230.      { Just Isn't Fast Enough To Properly Display BOTH Sinus Bars }
  231.      { And The Color Transitions For The Large Text.              }
  232.      ASM
  233.         PUSH DS
  234.         MOV AX, SEG @Data
  235.         MOV DS, AX
  236.         CLI
  237.  
  238.         { Wait For End Of Vertical Retrace }
  239.         MOV DX, Status1
  240.         @NotVert:
  241.           IN  AL, DX
  242.           AND AL, 8
  243.         JNZ @NotVert
  244.         @IsVert:
  245.           IN  AL, DX
  246.           AND AL, 8
  247.         JZ @IsVert
  248.  
  249.  
  250.         @DrawAllBarsLoop:
  251.           {--- Check For Bars ---}
  252.           MOV CX, 3
  253.           @BarRasterCompare:
  254.  
  255.             { Calculate Location of Bar (Start Line Placed In AX) }
  256.             MOV BX, CX
  257.             DEC BX
  258.             SHL BX, 1
  259.             MOV BX, word(BarPos[BX])
  260.             AND BX, 255
  261.             SHL BX, 1
  262.             MOV AX, word(SinTab[BX])
  263.  
  264.             { Check If A Bar Is On Current Raster }
  265.             CMP AX, Raster
  266.             JNS @BarNotDisplayed
  267.             MOV BX, AX
  268.             ADD AX, 20
  269.             CMP Raster, AX
  270.             JNS @BarNotDisplayed
  271.  
  272.             { Bar Is On Raster So Mark It }
  273.             SUB BX, Raster
  274.             XOR AX, AX
  275.             SUB AX, BX
  276.  
  277.             MOV word(DrawBar), AX
  278.             MOV word(BarNum), CX
  279.             DEC word(BarNum)
  280.  
  281.             @BarNotDisplayed:
  282.             @DoneChecking:
  283.           LOOP @BarRasterCompare
  284.  
  285.           {--- Draw Bars ---}
  286.           MOV  BX, DrawBar
  287.           OR   BX, BX
  288.           JL   @NoDrawBar
  289.  
  290.           { Build Index To Bar Color Table }
  291.           SHL BX, 2
  292.  
  293.           MOV AX, word(BarNum)
  294.           MOV CX, AX
  295.           SHL AX, 6
  296.           SHL CX, 4
  297.           ADD AX, CX
  298.           ADD BX, AX
  299.  
  300.           { Set Up Next Scan Line Color }
  301.           MOV DX, DACWRITE
  302.           XOR AX, AX
  303.           OUT DX, AL
  304.  
  305.           MOV DX, DACDATA
  306.           INC BX
  307.           MOV AL, Byte(Bar[BX])
  308.           OUT DX, AL
  309.           INC BX
  310.           MOV AL, Byte(Bar[BX])
  311.           OUT DX, AL
  312.  
  313.           { Wait For End of Horiz Retrace }
  314.           MOV DX, Status1
  315.           @NotHoriz1:
  316.             IN  AL, DX
  317.             AND AL, 1
  318.           JNZ @NotHoriz1
  319.           @IsHoriz1:
  320.             IN  AL, DX
  321.             AND AL, 1
  322.           JZ @IsHoriz1
  323.  
  324.           { Send Last Byte Of DAC Reg So Color Is Updated }
  325.           MOV DX, DACDATA
  326.           INC BX
  327.           MOV AL, byte(Bar[BX])
  328.           OUT DX, AL
  329.  
  330.           { Update Color From Copper Table }
  331.           MOV DX, DACWRITE
  332.           MOV BX, Raster
  333.           SHL BX, 2
  334.           MOV AL, Byte(CopperList[BX])
  335.           OUT DX, AL
  336.  
  337.           MOV DX, DACDATA
  338.           INC BX
  339.           MOV AL, Byte(CopperList[BX])
  340.           OUT DX, AL
  341.           INC BX
  342.           MOV AL, Byte(CopperList[BX])
  343.           OUT DX, AL
  344.           INC BX
  345.           MOV AL, Byte(CopperList[BX])
  346.           OUT DX, AL
  347.  
  348.           JMP @Done
  349.  
  350.           @NoDrawBar:
  351.           { Update Color }
  352.           MOV DX, DACWRITE
  353.           MOV BX, Raster
  354.           SHL BX, 2
  355.           MOV AL, Byte(CopperList[BX])
  356.           OUT DX, AL
  357.  
  358.           MOV DX, DACDATA
  359.           INC BX
  360.           MOV AL, Byte(CopperList[BX])
  361.           OUT DX, AL
  362.           INC BX
  363.           MOV AL, Byte(CopperList[BX])
  364.           OUT DX, AL
  365.  
  366.           { Wait For End of Horiz Retrace }
  367.           MOV DX, Status1
  368.           @NotHoriz2:
  369.             IN  AL, DX
  370.             AND AL, 1
  371.           JNZ @NotHoriz2
  372.           @IsHoriz2:
  373.             IN  AL, DX
  374.             AND AL, 1
  375.           JZ @IsHoriz2
  376.  
  377.           { Update Last }
  378.           MOV DX, DACDATA
  379.           INC BX
  380.           MOV AL, Byte(CopperList[BX])
  381.           OUT DX, AL
  382.  
  383.           @Done:
  384.  
  385.           INC Word(Raster)
  386.  
  387.        { If Raster <= 250 Then Loop }
  388.        CMP Word(Raster), 250
  389.        JLE @DrawAllBarsLoop
  390.  
  391.        {--- Color Background And Text At Bottom of Screen ---}
  392.        @TextColorLoop:
  393.           MOV DX, DACWRITE
  394.           MOV BX, Raster
  395.           SHL BX, 2
  396.           MOV AL, Byte(CopperList[BX])
  397.           OUT DX, AL
  398.  
  399.           MOV DX, DACDATA
  400.           INC BX
  401.           MOV AL, Byte(CopperList[BX])
  402.           OUT DX, AL
  403.           INC BX
  404.           MOV AL, Byte(CopperList[BX])
  405.           OUT DX, AL
  406.  
  407.           MOV DX, Status1
  408.           @NotHoriz3:
  409.             IN  AL, DX
  410.             AND AL, 1
  411.           JNZ @NotHoriz3
  412.           @IsHoriz3:
  413.             IN  AL, DX
  414.             AND AL, 1
  415.           JZ @IsHoriz3
  416.  
  417.           MOV DX, DACDATA
  418.           INC BX
  419.           MOV AL, Byte(CopperList[BX])
  420.           OUT DX, AL
  421.  
  422.           INC Word(Raster)
  423.        CMP Word(Raster), MaxRaster
  424.        JLE @TextColorLoop
  425.        STI
  426.        POP DS
  427.      END;
  428. End;
  429. {=[ Main Program ]=========================================================}
  430. Var Key : Char;
  431. Begin
  432.      TextMode (C80);
  433.      MakeSinTab;
  434.      MakeCopperList;
  435.      MakeBars;
  436.      SetUpScreen;
  437.      BarPos[0] := 30;
  438.      BarPos[1] := 15;
  439.      BarPos[2] :=  0;
  440.      Repeat
  441.            UpdateCopper;
  442.      Until Keypressed;
  443.      While Keypressed do
  444.            Key := ReadKey;
  445.      TextMode (C80);
  446. End.
  447.  
  448.